home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / amigaunits / gadtools.pas < prev    next >
Pascal/Delphi Source File  |  2000-01-01  |  24KB  |  753 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998-2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. {
  17.     History:
  18.  
  19.     Added autoopening of gadtools.library.
  20.     15 Jul 2000.
  21.  
  22.     Added MessageBox for error report.
  23.     31 Jul 2000.
  24.  
  25.     nils.sjoholm@mailbox.swipnet.se
  26.  
  27. }
  28.  
  29. unit gadtools;
  30.  
  31. INTERFACE
  32.  
  33. uses exec, intuition, graphics, utility;
  34.  
  35.  
  36. {------------------------------------------------------------------------}
  37.  
  38. {  The kinds (almost classes) of gadgets in the toolkit.  Use these
  39.     identifiers when calling CreateGadgetA() }
  40.  
  41. CONST
  42.  GENERIC_KIND  =  0;
  43.  BUTTON_KIND   =  1;
  44.  CHECKBOX_KIND =  2;
  45.  INTEGER_KIND  =  3;
  46.  LISTVIEW_KIND =  4;
  47.  MX_KIND       =  5;
  48.  NUMBER_KIND   =  6;
  49.  CYCLE_KIND    =  7;
  50.  PALETTE_KIND  =  8;
  51.  SCROLLER_KIND =  9;
  52. { Kind number 10 is reserved }
  53.  SLIDER_KIND   =  11;
  54.  STRING_KIND   =  12;
  55.  TEXT_KIND     =  13;
  56.  
  57.  NUM_KINDS     =  14;
  58.  
  59.  GADTOOLSNAME   : PChar = 'gadtools.library';
  60.  
  61.  
  62. {------------------------------------------------------------------------}
  63.  
  64. {  'Or' the appropriate set together for your Window IDCMPFlags: }
  65.  
  66.  ARROWIDCMP    =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN +
  67.                    IDCMP_INTUITICKS + IDCMP_MOUSEBUTTONS);
  68.  
  69.  BUTTONIDCMP   =  (IDCMP_GADGETUP);
  70.  CHECKBOXIDCMP =  (IDCMP_GADGETUP);
  71.  INTEGERIDCMP  =  (IDCMP_GADGETUP);
  72.  LISTVIEWIDCMP =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN +
  73.                    IDCMP_MOUSEMOVE + ARROWIDCMP);
  74.  
  75.  MXIDCMP       =  (IDCMP_GADGETDOWN);
  76.  NUMBERIDCMP   =  0;
  77.  CYCLEIDCMP    =  (IDCMP_GADGETUP);
  78.  PALETTEIDCMP  =  (IDCMP_GADGETUP);
  79.  
  80. {  Use ARROWIDCMP+SCROLLERIDCMP if your scrollers have arrows: }
  81.  SCROLLERIDCMP =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN + IDCMP_MOUSEMOVE);
  82.  SLIDERIDCMP   =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN + IDCMP_MOUSEMOVE);
  83.  STRINGIDCMP   =  (IDCMP_GADGETUP);
  84.  
  85.  TEXTIDCMP     =  0;
  86.  
  87.  
  88. {------------------------------------------------------------------------}
  89.  
  90. {  Generic NewGadget used by several of the gadget classes: }
  91.  
  92. Type
  93.    pNewGadget = ^tNewGadget;
  94.    tNewGadget = record
  95.     ng_LeftEdge, ng_TopEdge : Integer;     {  gadget position }
  96.     ng_Width, ng_Height     : Integer;     {  gadget size }
  97.     ng_GadgetText           : STRPTR;      {  gadget label }
  98.     ng_TextAttr             : pTextAttr;   {  desired font for gadget label }
  99.     ng_GadgetID             : Word;        {  gadget ID }
  100.     ng_Flags                : ULONG;       {  see below }
  101.     ng_VisualInfo           : Pointer;     {  Set to retval of GetVisualInfo() }
  102.     ng_UserData             : Pointer;     {  gadget UserData }
  103.    END;
  104.  
  105.  
  106. {  ng_Flags control certain aspects of the gadget.  The first five control
  107.     the placement of the descriptive text.  All larger groups supply a
  108.     default: }
  109.  
  110. CONST
  111.  PLACETEXT_LEFT  = $0001;  { Right-align text on left side }
  112.  PLACETEXT_RIGHT = $0002;  { Left-align text on right side }
  113.  PLACETEXT_ABOVE = $0004;  { Center text above }
  114.  PLACETEXT_BELOW = $0008;  { Center text below }
  115.  PLACETEXT_IN    = $0010;  { Center text on }
  116.  
  117.  NG_HIGHLABEL    = $0020;  { Highlight the label }
  118.  
  119. {------------------------------------------------------------------------}
  120.  
  121. { Fill out an array of these and pass that to CreateMenus(): }
  122.  
  123. Type
  124.    pNewMenu = ^tNewMenu;
  125.    tNewMenu = record
  126.     nm_Type           : Byte;              {  See below }
  127.     nm_Label          : STRPTR;            {  Menu's label }
  128.     nm_CommKey        : STRPTR;            {  MenuItem Command Key Equiv }
  129.     nm_Flags          : Word;              {  Menu OR MenuItem flags (see note) }
  130.     nm_MutualExclude  : Longint;           {  MenuItem MutualExclude word }
  131.     nm_UserData       : Pointer;           {  For your own use, see note }
  132.    END;
  133.  
  134. const
  135. { Needed only by inside IM_ definitions below }
  136.  MENU_IMAGE     = 128;
  137.  
  138. { nm_Type determines what each NewMenu structure corresponds to.
  139.  * for the NM_TITLE, NM_ITEM, and NM_SUB values, nm_Label should
  140.  * be a text string to use for that menu title, item, or sub-item.
  141.  * For IM_ITEM or IM_SUB, set nm_Label to point at the Image structure
  142.  * you wish to use for this item or sub-item.
  143.  * NOTE: At present, you may only use conventional images.
  144.  * Custom images created from Intuition image-classes do not work.
  145.  }
  146.  NM_TITLE      =  1;       { Menu header }
  147.  NM_ITEM       =  2;       { Textual menu item }
  148.  NM_SUB        =  3;       { Textual menu sub-item }
  149.  
  150.  IM_ITEM       =  (NM_ITEM OR MENU_IMAGE);    { Graphical menu item }
  151.  IM_SUB        =  (NM_SUB OR MENU_IMAGE);     { Graphical menu sub-item }
  152.  
  153. { The NewMenu array should be terminated with a NewMenu whose
  154.  * nm_Type equals NM_END.
  155.  }
  156.  NM_END        =  0;       { End of NewMenu array }
  157.  
  158. { Starting with V39, GadTools will skip any NewMenu entries whose
  159.  * nm_Type field has the NM_IGNORE bit set.
  160.  }
  161.  NM_IGNORE     =  64;
  162.  
  163.  
  164. { nm_Label should be a text string for textual items, a pointer
  165.  * to an Image structure for graphical menu items, or the special
  166.  * constant NM_BARLABEL, to get a separator bar.
  167.  }
  168.  NM_BARLABEL   = -1;
  169.  
  170. { The nm_Flags field is used to fill out either the Menu->Flags or
  171.  * MenuItem->Flags field.  Note that the sense of the MENUENABLED or
  172.  * ITEMENABLED bit is inverted between this use and Intuition's use,
  173.  * in other words, NewMenus are enabled by default.  The following
  174.  * labels are provided to disable them:
  175.  }
  176.  NM_MENUDISABLED = MENUENABLED;
  177.  NM_ITEMDISABLED = ITEMENABLED;
  178.  
  179. { New for V39:  NM_COMMANDSTRING.  For a textual MenuItem or SubItem,
  180.  * point nm_CommKey at an arbitrary string, and set the NM_COMMANDSTRING
  181.  * flag.
  182.  }
  183.  NM_COMMANDSTRING = COMMSEQ;
  184.  
  185. { The following are pre-cleared (COMMSEQ, ITEMTEXT, and HIGHxxx are set
  186.  * later as appropriate):
  187.  * Under V39, the COMMSEQ flag bit is not cleared, since it now has
  188.  * meaning.
  189.  }
  190.  NM_FLAGMASK    = NOT (COMMSEQ OR ITEMTEXT OR HIGHFLAGS);
  191.  NM_FLAGMASK_V39 = NOT (ITEMTEXT OR HIGHFLAGS);
  192.  
  193. { You may choose among CHECKIT, MENUTOGGLE, and CHECKED.
  194.  * Toggle-select menuitems are of type CHECKIT|MENUTOGGLE, along
  195.  * with CHECKED if currently selected.  Mutually exclusive ones
  196.  * are of type CHECKIT, and possibly CHECKED too.  The nm_MutualExclude
  197.  * is a bit-wise representation of the items excluded by this one,
  198.  * so in the simplest case (choose 1 among n), these flags would be
  199.  * ~1, ~2, ~4, ~8, ~16, etc.  See the Intuition Menus chapter.
  200.  }
  201.  
  202. { A UserData pointer can be associated with each Menu and MenuItem structure.
  203.  * The CreateMenus() call allocates space for a UserData after each
  204.  * Menu or MenuItem (header, item or sub-item).  You should use the
  205.  * GTMENU_USERDATA() or GTMENUITEM_USERDATA() macro to extract it.
  206.  }
  207.  
  208. const
  209. { These return codes can be obtained through the GTMN_SecondaryError tag }
  210.  GTMENU_TRIMMED = $00000001;      { Too many menus, items, or subitems,
  211.                                          * menu has been trimmed down
  212.                                          }
  213.  GTMENU_INVALID = $00000002;      { Invalid NewMenu array }
  214.  GTMENU_NOMEM   = $00000003;      { Out of memory }
  215.  
  216. {------------------------------------------------------------------------}
  217.  
  218. { Starting with V39, checkboxes and mx gadgets can be scaled to your
  219.  * specified gadget width/height.  Use the new GTCB_Scaled or GTMX_Scaled
  220.  * tags, respectively.  Under V37, and by default in V39, the imagery
  221.  * is of the following fixed size:
  222.  }
  223.  
  224. { MX gadget default dimensions: }
  225.  MX_WIDTH      =  17;
  226.  MX_HEIGHT     =  9;
  227.  
  228. { Checkbox default dimensions: }
  229.  CHECKBOX_WIDTH  = 26;
  230.  CHECKBOX_HEIGHT = 11;
  231.  
  232. {------------------------------------------------------------------------}
  233.  
  234.  
  235. {------------------------------------------------------------------------}
  236.  
  237. {  Tags for GadTools functions: }
  238. CONST
  239.  GT_TagBase        =   TAG_USER + $80000;
  240.  
  241.  GTVI_NewWindow    =   GT_TagBase+1;  { Unused }
  242.  GTVI_NWTags       =   GT_TagBase+2;  { Unused }
  243.  
  244.  GT_Private0       =   GT_TagBase+3;  { (private) }
  245.  
  246.  GTCB_Checked      =   GT_TagBase+4;  { State of checkbox }
  247.  
  248.  GTLV_Top          =   GT_TagBase+5;  { Top visible one in listview }
  249.  GTLV_Labels       =   GT_TagBase+6;  { List to display in listview }
  250.  GTLV_ReadOnly     =   GT_TagBase+7;  { TRUE IF listview is to be
  251.                                               read-only }
  252.  GTLV_ScrollWidth  =   GT_TagBase+8;  { Width of scrollbar }
  253.  
  254.  GTMX_Labels       =   GT_TagBase+9;  { NULL-terminated array of labels }
  255.  GTMX_Active       =   GT_TagBase+10; { Active one in mx gadget }
  256.  
  257.  GTTX_Text         =   GT_TagBase+11; { Text to display }
  258.  GTTX_CopyText     =   GT_TagBase+12; { Copy text label instead of
  259.                                               referencing it }
  260.  
  261.  GTNM_Number       =   GT_TagBase+13; { Number to display }
  262.  
  263.  GTCY_Labels       =   GT_TagBase+14; { NULL-terminated array of labels }
  264.  GTCY_Active       =   GT_TagBase+15; { The active one in the cycle gad }
  265.  
  266.  GTPA_Depth        =   GT_TagBase+16; { Number of bitplanes in palette }
  267.  GTPA_Color        =   GT_TagBase+17; { Palette color }
  268.  GTPA_ColorOffset  =   GT_TagBase+18; { First color to use in palette }
  269.  GTPA_IndicatorWidth = GT_TagBase+19; { Width of current-color indicator }
  270.  GTPA_IndicatorHeight = GT_TagBase+20; { Height of current-color indicator }
  271.  
  272.  GTSC_Top          =   GT_TagBase+21; { Top visible in scroller }
  273.  GTSC_Total        =   GT_TagBase+22; { Total in scroller area }
  274.  GTSC_Visible      =   GT_TagBase+23; { Number visible in scroller }
  275.  GTSC_Overlap      =   GT_TagBase+24; { Unused }
  276.  
  277. {  GT_TagBase+25 through GT_TagBase+37 are reserved }
  278.  
  279.  GTSL_Min          =   GT_TagBase+38; { Slider min value }
  280.  GTSL_Max          =   GT_TagBase+39; { Slider max value }
  281.  GTSL_Level        =   GT_TagBase+40; { Slider level }
  282.  GTSL_MaxLevelLen  =   GT_TagBase+41; { Max length of printed level }
  283.  GTSL_LevelFormat  =   GT_TagBase+42; { Format string for level }
  284.  GTSL_LevelPlace   =   GT_TagBase+43; { Where level should be placed }
  285.  GTSL_DispFunc     =   GT_TagBase+44; { Callback for number calculation
  286.                                               before display }
  287.  
  288.  GTST_String       =   GT_TagBase+45; { String gadget's displayed string }
  289.  GTST_MaxChars     =   GT_TagBase+46; { Max length of string }
  290.  
  291.  GTIN_Number       =   GT_TagBase+47; { Number in integer gadget }
  292.  GTIN_MaxChars     =   GT_TagBase+48; { Max number of digits }
  293.  
  294.  GTMN_TextAttr     =   GT_TagBase+49; { MenuItem font TextAttr }
  295.  GTMN_FrontPen     =   GT_TagBase+50; { MenuItem text pen color }
  296.  
  297.  GTBB_Recessed     =   GT_TagBase+51; { Make BevelBox recessed }
  298.  
  299.  GT_VisualInfo     =   GT_TagBase+52; { result of VisualInfo call }
  300.  
  301.  GTLV_ShowSelected =   GT_TagBase+53; { show selected entry beneath
  302.                 listview, set tag data = NULL for display-only, or pointer
  303.                 to a string gadget you've created }
  304.  GTLV_Selected     =   GT_TagBase+54; { Set ordinal number of selected
  305.                                               entry in the list }
  306.  GT_Reserved0      =   GT_TagBase+55; { Reserved }
  307.  GT_Reserved1      =   GT_TagBase+56; { Reserved for future use }
  308.  
  309.  GTTX_Border       =   GT_TagBase+57; { Put a border around
  310.                                               Text-display gadgets }
  311.  GTNM_Border       =   GT_TagBase+58; { Put a border around
  312.                                               Number-display gadgets }
  313.  
  314.  GTSC_Arrows       =   GT_TagBase+59; { Specify size of arrows for
  315.                                               scroller }
  316.  
  317.  GTMN_Menu         =   GT_TagBase+60; { Pointer to Menu for use by
  318.                                               LayoutMenuItems() }
  319.  GTMX_Spacing      =   GT_TagBase+61; { Added to font height to
  320.                 figure spacing between mx choices.  Use this instead
  321.                 of LAYOUTA_SPACING for mx gadgets. }
  322.  
  323. { New to V37 GadTools.  Ignored by GadTools V36 }
  324.  GTMN_FullMenu     =   GT_TagBase+62; { Asks CreateMenus() to
  325.                 validate that this is a complete menu structure }
  326.  GTMN_SecondaryError =  GT_TagBase+63; { ti_Data is a pointer
  327.                 to a ULONG to receive error reports from CreateMenus() }
  328.  GT_Underscore     =   GT_TagBase+64; { ti_Data points to the symbol
  329.                 that preceeds the character you'd like to underline in a
  330.                 gadget label }
  331.  
  332. { New to V39 GadTools.  Ignored by GadTools V36 and V37 }
  333.  GTMN_Checkmark     =  GT_TagBase+65; { ti_Data is checkmark img to use }
  334.  GTMN_AmigaKey      =  GT_TagBase+66; { ti_Data is Amiga-key img to use }
  335.  GTMN_NewLookMenus  =  GT_TagBase+67; { ti_Data is boolean }
  336.  
  337. { New to V39 GadTools.  Ignored by GadTools V36 and V37.
  338.  * Set to TRUE if you want the checkbox or mx image scaled to
  339.  * the gadget width/height you specify.  Defaults to FALSE,
  340.  * for compatibility.
  341.  }
  342.  GTCB_Scaled         = GT_TagBase+68; { ti_Data is boolean }
  343.  GTMX_Scaled         = GT_TagBase+69; { ti_Data is boolean }
  344.  
  345.  GTPA_NumColors      = GT_TagBase+70; { Number of colors in palette }
  346.  
  347.  GTMX_TitlePlace     = GT_TagBase+71; { Where to put the title }
  348.  
  349.  GTTX_FrontPen       = GT_TagBase+72; { Text color in TEXT_KIND gad }
  350.  GTTX_BackPen        = GT_TagBase+73; { Bgrnd color in TEXT_KIND gad }
  351.  GTTX_Justification  = GT_TagBase+74; { See GTJ_#? constants }
  352.  
  353.  GTNM_FrontPen       = GT_TagBase+72; { Text color in NUMBER_KIND gad }
  354.  GTNM_BackPen        = GT_TagBase+73; { Bgrnd color in NUMBER_KIND gad }
  355.  GTNM_Justification  = GT_TagBase+74; { See GTJ_#? constants }
  356.  GTNM_Format         = GT_TagBase+75; { Formatting string for number }
  357.  GTNM_MaxNumberLen   = GT_TagBase+76; { Maximum length of number }
  358.  
  359.  GTBB_FrameType      = GT_TagBase+77; { defines what kind of boxes
  360.                                             * DrawBevelBox() renders. See
  361.                                             * the BBFT_#? constants for
  362.                                             * possible values
  363.                                             }
  364.  
  365.  GTLV_MakeVisible    = GT_TagBase+78; { Make this item visible }
  366.  GTLV_ItemHeight     = GT_TagBase+79; { Height of an individual item }
  367.  
  368.  GTSL_MaxPixelLen    = GT_TagBase+80; { Max pixel size of level display }
  369.  GTSL_Justification  = GT_TagBase+81; { how should the level be displayed }
  370.  
  371.  GTPA_ColorTable     = GT_TagBase+82; { colors to use in palette }
  372.  
  373.  GTLV_CallBack       = GT_TagBase+83; { general-purpose listview call back }
  374.  GTLV_MaxPen         = GT_TagBase+84; { maximum pen number used by call back }
  375.  
  376.  GTTX_Clipped        = GT_TagBase+85; { make a TEXT_KIND clip text }
  377.  GTNM_Clipped        = GT_TagBase+85; { make a NUMBER_KIND clip text }
  378.  
  379.  
  380. {------------------------------------------------------------------------}
  381.  
  382. { Justification types for GTTX_Justification and GTNM_Justification tags }
  383.  GTJ_LEFT   = 0;
  384.  GTJ_RIGHT  = 1;
  385.  GTJ_CENTER = 2;
  386.  
  387. {------------------------------------------------------------------------}
  388.  
  389. { Bevel box frame types for GTBB_FrameType tag }
  390.  BBFT_BUTTON      = 1;  { Standard button gadget box }
  391.  BBFT_RIDGE       = 2;  { Standard string gadget box }
  392.  BBFT_ICONDROPBOX = 3;  { Standard icon drop box     }
  393.  
  394. {------------------------------------------------------------------------}
  395.  
  396. { Typical suggested spacing between "elements": }
  397.  INTERWIDTH    =  8;
  398.  INTERHEIGHT   =  4;
  399.  
  400. {------------------------------------------------------------------------}
  401.  
  402.  
  403. {  "NWay" is an old synonym for cycle gadgets }
  404.  NWAY_KIND    =   CYCLE_KIND;
  405.  NWAYIDCMP    =   CYCLEIDCMP;
  406.  GTNW_Labels  =   GTCY_Labels;
  407.  GTNW_Active  =   GTCY_Active;
  408.  
  409. {------------------------------------------------------------------------}
  410.  
  411. { These two definitions are obsolete, but are here for backwards
  412.  * compatibility.  You never need to worry about these:
  413.  }
  414.  GADTOOLBIT    =  ($8000);
  415. { Use this mask to isolate the user part: }
  416.  GADTOOLMASK   =  NOT (GADTOOLBIT);
  417.  
  418. {------------------------------------------------------------------------}
  419.  
  420. { These definitions are for the GTLV_CallBack tag }
  421.  
  422. { The different types of messages that a listview callback hook can see }
  423.  LV_DRAW     =  $202;    { draw yourself, with state }
  424.  
  425. { Possible return values from a callback hook }
  426.  LVCB_OK      = 0;         { callback understands this message type    }
  427.  LVCB_UNKNOWN = 1;         { callback does not understand this message }
  428.  
  429. { states for LVDrawMsg.lvdm_State }
  430.  LVR_NORMAL           = 0; { the usual                 }
  431.  LVR_SELECTED         = 1; { for selected gadgets      }
  432.  LVR_NORMALDISABLED   = 2;         { for disabled gadgets      }
  433.  LVR_SELECTEDDISABLED = 8;         { disabled and selected     }
  434.  
  435. Type
  436. { structure of LV_DRAW messages, object is a (struct Node *) }
  437.  pLVDrawMsg = ^tLVDrawMsg;
  438.  tLVDrawMsg = record
  439.     lvdm_MethodID       : ULONG;       { LV_DRAW                   }
  440.     lvdm_RastPort       : pRastPort;   { where to render to        }
  441.     lvdm_DrawInfo       : pDrawInfo;   { useful to have around     }
  442.     lvdm_Bounds         : tRectangle;  { limits of where to render }
  443.     lvdm_State          : ULONG;     { how to render     }
  444.  end;
  445.  
  446.  
  447. VAR
  448.     GadToolsBase : pLibrary;
  449.     gadtools_exit : Pointer;
  450.  
  451. FUNCTION CreateContext(glistptr : pGadget): pGadget;
  452. FUNCTION CreateGadgetA(kind : ULONG; gad : pGadget; ng : pNewGadget; taglist : pTagItem) : pGadget;
  453. FUNCTION CreateMenusA(newmenu : pNewMenu; taglist : pTagItem) : pMenu;
  454. PROCEDURE DrawBevelBoxA(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; taglist : pTagItem);
  455. PROCEDURE FreeGadgets(gad : pGadget);
  456. PROCEDURE FreeMenus(menu : pMenu);
  457. PROCEDURE FreeVisualInfo(vi : POINTER);
  458. FUNCTION GetVisualInfoA(screen : pScreen; taglist : pTagItem) : POINTER;
  459. PROCEDURE GT_BeginRefresh(win : pWindow);
  460. PROCEDURE GT_EndRefresh(win : pWindow; complete : LONGINT);
  461. FUNCTION GT_FilterIMsg(imsg : pIntuiMessage) : pIntuiMessage;
  462. FUNCTION GT_GetGadgetAttrsA(gad : pGadget; win : pWindow; req : pRequester; taglist : pTagItem) : LONGINT;
  463. FUNCTION GT_GetIMsg(iport : pMsgPort) : pIntuiMessage;
  464. FUNCTION GT_PostFilterIMsg(imsg : pIntuiMessage) : pIntuiMessage;
  465. PROCEDURE GT_RefreshWindow(win : pWindow; req : pRequester);
  466. PROCEDURE GT_ReplyIMsg(imsg : pIntuiMessage);
  467. PROCEDURE GT_SetGadgetAttrsA(gad : pGadget; win : pWindow; req : pRequester; taglist : pTagItem);
  468. FUNCTION LayoutMenuItemsA(firstitem : pMenuItem; vi : POINTER; taglist : pTagItem) : BOOLEAN;
  469. FUNCTION LayoutMenusA(firstmenu : pMenu; vi : POINTER; taglist : pTagItem) : BOOLEAN;
  470.  
  471. IMPLEMENTATION
  472.  
  473. uses msgbox;
  474.  
  475. FUNCTION CreateContext(glistptr : pGadget): pGadget;
  476. BEGIN
  477.   ASM
  478.     MOVE.L  A6,-(A7)
  479.     MOVEA.L glistptr,A0
  480.     MOVEA.L GadToolsBase,A6
  481.     JSR -114(A6)
  482.     MOVEA.L (A7)+,A6
  483.     MOVE.L  D0,@RESULT
  484.   END;
  485. END;
  486.  
  487. FUNCTION CreateGadgetA(kind : ULONG; gad : pGadget; ng : pNewGadget; taglist : pTagItem) : pGadget;
  488. BEGIN
  489.   ASM
  490.     MOVE.L  A6,-(A7)
  491.     MOVE.L  kind,D0
  492.     MOVEA.L gad,A0
  493.     MOVEA.L ng,A1
  494.     MOVEA.L taglist,A2
  495.     MOVEA.L GadToolsBase,A6
  496.     JSR -030(A6)
  497.     MOVEA.L (A7)+,A6
  498.     MOVE.L  D0,@RESULT
  499.   END;
  500. END;
  501.  
  502. FUNCTION CreateMenusA(newmenu : pNewMenu; taglist : pTagItem) : pMenu;
  503. BEGIN
  504.   ASM
  505.     MOVE.L  A6,-(A7)
  506.     MOVEA.L newmenu,A0
  507.     MOVEA.L taglist,A1
  508.     MOVEA.L GadToolsBase,A6
  509.     JSR -048(A6)
  510.     MOVEA.L (A7)+,A6
  511.     MOVE.L  D0,@RESULT
  512.   END;
  513. END;
  514.  
  515. PROCEDURE DrawBevelBoxA(rport : pRastPort; left : LONGINT; top : LONGINT; width : LONGINT; height : LONGINT; taglist : pTagItem);
  516. BEGIN
  517.   ASM
  518.     MOVE.L  A6,-(A7)
  519.     MOVEA.L rport,A0
  520.     MOVE.L  left,D0
  521.     MOVE.L  top,D1
  522.     MOVE.L  width,D2
  523.     MOVE.L  height,D3
  524.     MOVEA.L taglist,A1
  525.     MOVEA.L GadToolsBase,A6
  526.     JSR -120(A6)
  527.     MOVEA.L (A7)+,A6
  528.   END;
  529. END;
  530.  
  531. PROCEDURE FreeGadgets(gad : pGadget);
  532. BEGIN
  533.   ASM
  534.     MOVE.L  A6,-(A7)
  535.     MOVEA.L gad,A0
  536.     MOVEA.L GadToolsBase,A6
  537.     JSR -036(A6)
  538.     MOVEA.L (A7)+,A6
  539.   END;
  540. END;
  541.  
  542. PROCEDURE FreeMenus(menu : pMenu);
  543. BEGIN
  544.   ASM
  545.     MOVE.L  A6,-(A7)
  546.     MOVEA.L menu,A0
  547.     MOVEA.L GadToolsBase,A6
  548.     JSR -054(A6)
  549.     MOVEA.L (A7)+,A6
  550.   END;
  551. END;
  552.  
  553. PROCEDURE FreeVisualInfo(vi : POINTER);
  554. BEGIN
  555.   ASM
  556.     MOVE.L  A6,-(A7)
  557.     MOVEA.L vi,A0
  558.     MOVEA.L GadToolsBase,A6
  559.     JSR -132(A6)
  560.     MOVEA.L (A7)+,A6
  561.   END;
  562. END;
  563.  
  564. FUNCTION GetVisualInfoA(screen : pScreen; taglist : pTagItem) : POINTER;
  565. BEGIN
  566.   ASM
  567.     MOVE.L  A6,-(A7)
  568.     MOVEA.L screen,A0
  569.     MOVEA.L taglist,A1
  570.     MOVEA.L GadToolsBase,A6
  571.     JSR -126(A6)
  572.     MOVEA.L (A7)+,A6
  573.     MOVE.L  D0,@RESULT
  574.   END;
  575. END;
  576.  
  577. PROCEDURE GT_BeginRefresh(win : pWindow);
  578. BEGIN
  579.   ASM
  580.     MOVE.L  A6,-(A7)
  581.     MOVEA.L win,A0
  582.     MOVEA.L GadToolsBase,A6
  583.     JSR -090(A6)
  584.     MOVEA.L (A7)+,A6
  585.   END;
  586. END;
  587.  
  588. PROCEDURE GT_EndRefresh(win : pWindow; complete : LONGINT);
  589. BEGIN
  590.   ASM
  591.     MOVE.L  A6,-(A7)
  592.     MOVEA.L win,A0
  593.     MOVE.L  complete,D0
  594.     MOVEA.L GadToolsBase,A6
  595.     JSR -096(A6)
  596.     MOVEA.L (A7)+,A6
  597.   END;
  598. END;
  599.  
  600. FUNCTION GT_FilterIMsg(imsg : pIntuiMessage) : pIntuiMessage;
  601. BEGIN
  602.   ASM
  603.     MOVE.L  A6,-(A7)
  604.     MOVEA.L imsg,A1
  605.     MOVEA.L GadToolsBase,A6
  606.     JSR -102(A6)
  607.     MOVEA.L (A7)+,A6
  608.     MOVE.L  D0,@RESULT
  609.   END;
  610. END;
  611.  
  612. FUNCTION GT_GetGadgetAttrsA(gad : pGadget; win : pWindow; req : pRequester; taglist : pTagItem) : LONGINT;
  613. BEGIN
  614.   ASM
  615.     MOVE.L  A6,-(A7)
  616.     MOVEA.L gad,A0
  617.     MOVEA.L win,A1
  618.     MOVEA.L req,A2
  619.     MOVEA.L taglist,A3
  620.     MOVEA.L GadToolsBase,A6
  621.     JSR -174(A6)
  622.     MOVEA.L (A7)+,A6
  623.     MOVE.L  D0,@RESULT
  624.   END;
  625. END;
  626.  
  627. FUNCTION GT_GetIMsg(iport : pMsgPort) : pIntuiMessage;
  628. BEGIN
  629.   ASM
  630.     MOVE.L  A6,-(A7)
  631.     MOVEA.L iport,A0
  632.     MOVEA.L GadToolsBase,A6
  633.     JSR -072(A6)
  634.     MOVEA.L (A7)+,A6
  635.     MOVE.L  D0,@RESULT
  636.   END;
  637. END;
  638.  
  639. FUNCTION GT_PostFilterIMsg(imsg : pIntuiMessage) : pIntuiMessage;
  640. BEGIN
  641.   ASM
  642.     MOVE.L  A6,-(A7)
  643.     MOVEA.L imsg,A1
  644.     MOVEA.L GadToolsBase,A6
  645.     JSR -108(A6)
  646.     MOVEA.L (A7)+,A6
  647.     MOVE.L  D0,@RESULT
  648.   END;
  649. END;
  650.  
  651. PROCEDURE GT_RefreshWindow(win : pWindow; req : pRequester);
  652. BEGIN
  653.   ASM
  654.     MOVE.L  A6,-(A7)
  655.     MOVEA.L win,A0
  656.     MOVEA.L req,A1
  657.     MOVEA.L GadToolsBase,A6
  658.     JSR -084(A6)
  659.     MOVEA.L (A7)+,A6
  660.   END;
  661. END;
  662.  
  663. PROCEDURE GT_ReplyIMsg(imsg : pIntuiMessage);
  664. BEGIN
  665.   ASM
  666.     MOVE.L  A6,-(A7)
  667.     MOVEA.L imsg,A1
  668.     MOVEA.L GadToolsBase,A6
  669.     JSR -078(A6)
  670.     MOVEA.L (A7)+,A6
  671.   END;
  672. END;
  673.  
  674. PROCEDURE GT_SetGadgetAttrsA(gad : pGadget; win : pWindow; req : pRequester; taglist : pTagItem);
  675. BEGIN
  676.   ASM
  677.     MOVE.L  A6,-(A7)
  678.     MOVEA.L gad,A0
  679.     MOVEA.L win,A1
  680.     MOVEA.L req,A2
  681.     MOVEA.L taglist,A3
  682.     MOVEA.L GadToolsBase,A6
  683.     JSR -042(A6)
  684.     MOVEA.L (A7)+,A6
  685.   END;
  686. END;
  687.  
  688. FUNCTION LayoutMenuItemsA(firstitem : pMenuItem; vi : POINTER; taglist : pTagItem) : BOOLEAN;
  689. BEGIN
  690.   ASM
  691.     MOVE.L  A6,-(A7)
  692.     MOVEA.L firstitem,A0
  693.     MOVEA.L vi,A1
  694.     MOVEA.L taglist,A2
  695.     MOVEA.L GadToolsBase,A6
  696.     JSR -060(A6)
  697.     MOVEA.L (A7)+,A6
  698.     TST.W   D0
  699.     BEQ.B   @end
  700.     MOVEQ   #1,D0
  701.   @end: MOVE.B  D0,@RESULT
  702.   END;
  703. END;
  704.  
  705. FUNCTION LayoutMenusA(firstmenu : pMenu; vi : POINTER; taglist : pTagItem) : BOOLEAN;
  706. BEGIN
  707.   ASM
  708.     MOVE.L  A6,-(A7)
  709.     MOVEA.L firstmenu,A0
  710.     MOVEA.L vi,A1
  711.     MOVEA.L taglist,A2
  712.     MOVEA.L GadToolsBase,A6
  713.     JSR -066(A6)
  714.     MOVEA.L (A7)+,A6
  715.     TST.W   D0
  716.     BEQ.B   @end
  717.     MOVEQ   #1,D0
  718.   @end: MOVE.B  D0,@RESULT
  719.   END;
  720. END;
  721.  
  722. procedure CloseGadToolsLibrary;
  723. begin
  724.     ExitProc := gadtools_exit;
  725.     if GadToolsBase <> nil then begin
  726.         CloseLibrary(GadToolsBase);
  727.         GadToolsBase := nil;
  728.     end;
  729. end;
  730.  
  731. const
  732.    VERSION        : string[2] = '37';
  733.  
  734. begin
  735.     GadToolsBase := nil;
  736.     GadToolsBase := OpenLibrary(GADTOOLSNAME,37);
  737.     if GadToolsBase <> nil then begin
  738.          gadtools_Exit := ExitProc;
  739.          ExitProc := @CloseGadToolsLibrary;
  740.     end else begin
  741.          MessageBox('FPC Pascal Error',
  742.                     'Can''t open gadtools.library version ' + 
  743.                     VERSION +
  744.                     chr(10) + 
  745.                     'Deallocating resources and closing down',
  746.                     'Oops');
  747.          halt(20);
  748.     end;
  749. END. (* UNIT GADTOOLS *)
  750.  
  751.  
  752.  
  753.